Deutsche Edition 1/Deutsche Edition 1.iso/amok/031-040/amok32/ringbuffers/ringbuffers.mod

Text File | 1993-11-04 | 6KB | 207 lines

(**********************************************************************

    :Program.    RingBuffers.mod
    :Contents.   Generic data type: ring buffer
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      [phone]
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.27d
    :Imports.    TaskMemory [bne]
    :History.    V1.0 [bne] 31.Dec.1989
    :History.    V1.1 [bne] 01.Jan.1990 (bug fixes)
    :History.    V1.2 [bne] 10.Jan.1990 (+ multitasking)

**********************************************************************)

IMPLEMENTATION MODULE RingBuffers;

FROM Arts        IMPORT Assert;
FROM Exec        IMPORT MsgPort, MsgPortPtr, PutMsg, GetMsg, SetSignal, Node,
                        MsgPortAction, NodeType, TaskPtr;
FROM ExecSupport IMPORT NewList;
FROM SYSTEM      IMPORT ADDRESS, ADR, BYTE, LONGSET, SETREG;
FROM TaskMemory  IMPORT Allocate, Deallocate;

TYPE
  RingBuffer = POINTER TO RingBufferRec;
  RingBufferRec = RECORD
    fullQueue : MsgPort;
    emptyQueue: MsgPort;
    link: RingBufferBlock;
  END;
  RingBufferBlock = POINTER TO RingBufferBlockRec;
  RingBufferBlockRec = RECORD
    node: Node;
    link: RingBufferBlock;
    data: BYTE; (* Dummy *)
  END;

PROCEDURE InitMsgPort (VAR Port: MsgPort;
                           SigBit: INTEGER;
                           SigTask: TaskPtr);
  BEGIN
    WITH Port DO
      node.type:= msgPort;
      node.name:= NIL;
      node.pri := 0;
      flags    := signal;
      sigBit   := SigBit;
      sigTask  := SigTask;
      NewList (ADR (msgList));
    END;
  END InitMsgPort;

PROCEDURE CreateRingBuffer (VAR Buffer: RingBuffer;
                                BlockSize: LONGINT;
                                NumBlocks: CARDINAL;
                                FullSigTask: TaskPtr;
                                FullSignal: INTEGER;
                                EmptySigTask: TaskPtr;
                                EmptySignal: INTEGER): BOOLEAN;
  VAR
    BlockPtr: RingBufferBlock;
  BEGIN
    Assert (NumBlocks > 0, ADR ("RingBuffers: NumBlocks = 0"));
    RingBuffersAllocProc (Buffer, SIZE (RingBufferRec));
    IF Buffer # NIL THEN
      WITH Buffer^ DO
        link:= NIL;
        InitMsgPort (fullQueue, FullSignal, FullSigTask);
        InitMsgPort (emptyQueue, EmptySignal, EmptySigTask);
        REPEAT
          RingBuffersAllocProc (BlockPtr, SIZE (RingBufferBlockRec) +
                                BlockSize - 1);
          IF BlockPtr = NIL THEN
            DiscardRingBuffer (Buffer);
            RETURN FALSE
          END;
          BlockPtr^.link:= Buffer^.link;
          Buffer^.link:= BlockPtr;
          PutMsg (ADR (emptyQueue), BlockPtr);
          DEC (NumBlocks);
        UNTIL NumBlocks = 0;
        RETURN TRUE
      END;
      RingBuffersDeallocProc (Buffer);
    END;
    RETURN FALSE
  END CreateRingBuffer;

PROCEDURE ErrorNoBuffer;
  BEGIN
    Assert (FALSE, ADR ("RingBuffers: undefined buffer"));
  END ErrorNoBuffer;

PROCEDURE ErrorNoBlock;
  BEGIN
    Assert (FALSE, ADR ("RingBuffers: undefined block"));
  END ErrorNoBlock;

PROCEDURE DiscardRingBuffer (VAR Buffer: RingBuffer);
  VAR
    BlockPtr: RingBufferBlock;
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    WITH Buffer^ DO
      WHILE link # NIL DO
        BlockPtr:= link;
        link:= BlockPtr^.link;
        RingBuffersDeallocProc (BlockPtr);
      END;
    END;
    RingBuffersDeallocProc (Buffer);
    Buffer:= NIL;
  END DiscardRingBuffer;

PROCEDURE GetBlock (    Queue: MsgPortPtr;
                    VAR Block: RingBufferBlock;
                    VAR DataPtr: ADDRESS): BOOLEAN;
  BEGIN
    SETREG (0, SetSignal (LONGSET{}, LONGSET{Queue^.sigBit}));
    Block:= GetMsg (Queue);
    IF Block # NIL THEN
      DataPtr:= ADR (Block^.data);
      RETURN TRUE
    END;
    DataPtr:= NIL;
    RETURN FALSE
  END GetBlock;

PROCEDURE GetFullBlock (    Buffer: RingBuffer;
                        VAR Block: RingBufferBlock;
                        VAR DataPtr: ADDRESS): BOOLEAN;
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    RETURN GetBlock (ADR (Buffer^.fullQueue), Block, DataPtr);
  END GetFullBlock;

PROCEDURE GetEmptyBlock (    Buffer: RingBuffer;
                         VAR Block: RingBufferBlock;
                         VAR DataPtr: ADDRESS): BOOLEAN;
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    RETURN GetBlock (ADR (Buffer^.emptyQueue), Block, DataPtr);
  END GetEmptyBlock;

PROCEDURE PutFullBlock (    Buffer: RingBuffer;
                        VAR Block: RingBufferBlock);
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    IF Block = NIL THEN
      ErrorNoBlock;
    END;
    PutMsg (ADR (Buffer^.fullQueue), Block);
    Block:= NIL;
  END PutFullBlock;

PROCEDURE PutEmptyBlock (    Buffer: RingBuffer;
                         VAR Block: RingBufferBlock);
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    IF Block = NIL THEN
      ErrorNoBlock;
    END;
    PutMsg (ADR (Buffer^.emptyQueue), Block);
    Block:= NIL;
  END PutEmptyBlock;

PROCEDURE AllBlocksFull (Buffer: RingBuffer): BOOLEAN;
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    WITH Buffer^.emptyQueue DO
      SETREG (0, SetSignal (LONGSET{}, LONGSET{sigBit}));
      RETURN msgList.head^.succ = NIL
    END;
  END AllBlocksFull;

PROCEDURE AllBlocksEmpty (Buffer: RingBuffer): BOOLEAN;
  BEGIN
    IF Buffer = NIL THEN
      ErrorNoBuffer;
    END;
    WITH Buffer^.fullQueue DO
      SETREG (0, SetSignal (LONGSET{}, LONGSET{sigBit}));
      RETURN msgList.head^.succ = NIL
    END;
  END AllBlocksEmpty;

BEGIN
  RingBuffersAllocProc:= Allocate;
  RingBuffersDeallocProc:= Deallocate;
END RingBuffers.